#|______________________________________________________________________________
 |
 | plots001.lsp
 |
 | Contains the following constructor functions for the new ViSta Plots System:
 |
 |   scatter-plot
 |   scattter-plot-matrix
 |   3d-spinning-plot
 |   hd-spinning-plot
 |   box-or-diamond-plot 
 |   box-plot
 |   diamond-plot
 |   dot-plot
 |   parallel-coordinates-plot 
 |   pc-plot
 |   grouped-box-or-diamond-plot 
 |   labels-plot 
 |______________________________________________________________________________
 |#


(defun scatter-plot 
  (&optional data &key (ok-var-types '(numeric)) 
             variable-labels point-labels
             ;do not use :in?, :in??, or :in??? - reserved for system use
             (in nil in??) (in? nil in???) 
             (menu-item nil)
             (show t) (top-most t) 
             (location '(50 50)) (size '(320 320))
             (menu t) (title "Scatter Plot") 
             (legend1 (send $ :name)) (legend2 nil)
             (go-away t) (content-only nil))
  (let* ((actcon *active-container*)
         (in? (if in??? in? in??))
         (graph-frame (graph-frame :show nil))
         (pop-out (send graph-frame :seen-in in in?))
         (container (if (equal pop-out t) graph-frame pop-out))
         (graph-data (before-new-plot data ok-var-types ))
         (data-object (when (= 4 (length graph-data)) (fourth graph-data)))
         (graph))
    (unless variable-labels (setf variable-labels (second graph-data)))
    (unless point-labels (setf point-labels (third graph-data)))
    
    (setf graph-data (first graph-data))
    (unless legend2 (setf legend2 title))
    (setf graph (send vista-scatterplot-proto :new  graph-data                        
                      :variable-labels variable-labels :point-labels point-labels
                      :show nil                        :top-most top-most
                      :container container             :pop-out pop-out
                      :location location               :size size 
                      :menu menu                       :title title 
                      :legend1 legend1                 :legend2 legend2
                      :go-away go-away                 :content-only content-only))
    
    (if actcon 
        (enable-container actcon)
        (disable-container))
    (when graph
          (send graph :after-new-plot pop-out top-most show size container data-object))
    graph))




(defun scatter-plot-matrix 
  (&optional data &key (ok-var-types '(numeric)) 
             variable-labels point-labels
             ;do not use :in?, :in??, or :in??? - reserved for system use
             (in nil in??) (in? nil in???) 
             (menu-item nil)
             (show t) (top-most t) 
             (location '(50 50)) (size '(320 320))
             (title "Scatter Plot Matrix") 
             (legend1 (send $ :name)) (legend2 nil)
             (go-away t) (content-only nil))
  (let* ((actcon *active-container*)
         (in? (if in??? in? in??))
         (graph-frame (graph-frame :show nil))
         (pop-out (send graph-frame :seen-in in in?))
         (container (if (equal pop-out t) graph-frame pop-out))
         (graph-data (before-new-plot data ok-var-types ))
         (graph))
    (unless variable-labels (setf variable-labels (second graph-data)))
    (unless point-labels (setf point-labels (third graph-data)))
    (setf graph-data (first graph-data))
    (unless legend2 (setf legend2 title))
    (setf graph 
          (scatmat graph-data                        
                              :variable-labels variable-labels 
                              :point-labels point-labels
                              :show nil                        
                              :top-most top-most
                              :container container           
                              :pop-out pop-out
                              :location location 
                              :size size 
                              :menu nil
                              :title title 
                              :legend1 legend1  
                              :legend2 legend2
                              :go-away go-away       
                              :content-only content-only))
    
    (if actcon 
        (enable-container actcon)
        (disable-container))
    (when graph
          (send graph :point-color (iseq (send graph :num-points)) 'blue)
          (send graph :after-new-plot pop-out top-most show size container))
    graph))


(defun 3d-spinning-plot 
  (&optional data &key (ok-var-types '(numeric)) 
             variable-labels point-labels
             ;do not use :in?, :in??, or :in??? - reserved for system use
             (in nil in??) (in? nil in???) 
             (show t) (top-most t) 
             (location '(50 50)) (size '(320 320))
             (menu t) (title "3D Spinning Plot")
             (legend1 (send $ :name)) (legend2 nil)
             (go-away t) (content-only nil))
  (let* ((actcon *active-container*)
         (in? (if in??? in? in??))
         (graph-frame (graph-frame :show nil))
         (pop-out (send graph-frame :seen-in in in?))
         (container (if (equal pop-out t) graph-frame pop-out))
         (graph-data (before-new-plot data ok-var-types))
         (graph))
    (unless variable-labels (setf variable-labels (second graph-data)))
    (unless point-labels (setf point-labels (third graph-data)))
    (setf graph-data (first graph-data))
    (unless legend2 (setf legend2 title))
    (setf graph (send vista-spinplot-proto :new  graph-data                        
                      :variable-labels variable-labels :point-labels point-labels
                      :show nil                        :top-most top-most
                      :container container             :pop-out pop-out
                      :actcon actcon
                      :location location               :size size 
                      :menu menu                       :title title 
                      :legend1 legend1                 :legend2 legend2
                      :go-away go-away                 :content-only content-only))
    (when graph
          (send graph :after-new-plot pop-out top-most show size container))
    (send graph :scaled-range 
             (iseq (send graph :num-variables)) -2 2)
    graph))


(defun hd-touring-plot
  (&optional data &key (ok-var-types '(numeric)) 
             variable-labels point-labels
             ;do not use :in?, :in??, or :in??? - reserved for system use
             (in nil in??) (in? nil in???) 
             (menu-item nil)
             (show t) (top-most t) 
             (location '(50 50)) (size '(320 320))
             (title "hD Touring Plot") 
             (legend1 (send $ :name)) (legend2 nil)
             (go-away t) (content-only nil))
  (let* ((actcon *active-container*)
         (in? (if in??? in? in??))
         (graph-frame (graph-frame :show nil))
         (pop-out (send graph-frame :seen-in in in?))
         (container (if (equal pop-out t) graph-frame pop-out))
         (graph-data (before-new-plot data ok-var-types ))
         (graph))
    (unless variable-labels (setf variable-labels (second graph-data)))
    (unless point-labels (setf point-labels (third graph-data)))
    (setf graph-data (first graph-data))
    (unless legend2 (setf legend2 title))
    (setf graph 
          (tourplot graph-data                        
                    :variable-labels variable-labels 
                    :point-labels point-labels
                    :title title 
                    :location location 
                    :size size
                    :show nil))
    (when graph 
          (send graph :initial-tour))
    (if actcon 
        (enable-container actcon)
        (disable-container))
    (when graph
          (send graph :point-color (iseq (send graph :num-points)) 'blue)
          (send graph :after-new-plot pop-out top-most show size container)
          )
    graph))


(defun box-or-diamond-plot 
  (&optional data &key (ok-var-types '(numeric)) 
             variable-labels point-labels
             ;do not use :in?, :in??, or :in??? - reserved for system use
             (in nil in??) (in? nil in???) 
             (show t) (top-most t) 
             (location '(50 50)) (size '(320 320))
             (menu t) (title "Box or Diamond Plot") 
             (legend1 (send $ :name)) (legend2 nil)
             (go-away t) (content-only nil)
             (y-axis-label "Data") 
             (x-axis-label " ") 
             (category nil)
             (boxes t) 
             (diamonds nil) 
             (median-line nil) 
             (mean-line nil)        
             (equate t) 
             (enable-equate t) 
             (jitter t)
             (connect-points t) 
             (enable-connect-points t)
             )
"Args: &optional data &key (ok-var-types '(numeric)) (title nil) (in nil) (show t) variable-labels point-labels (legend1 (send $ :name)) (legend2 nil) (location '(50 50)) (size '(nil 250)) (go-away t) (content-only nil) (help-bar nil) (pop-up t) (y-axis-label \"Data\") (x-axis-label \" \") (category nil) (boxes t) (diamonds nil) (median-line t) (mean-line nil) (equate t) (enable-equate t) (jitter t) (connect-points t) (enable-connect-points t) (nvar nil)
DATA may be nil, an object, a list of lists, a list of vectors, or a matrix. If not specified, DATA is assumed to be and is converted to a list of vectors, one vector for each of the OK-VAR-TYPES variables in the current-data. Plot is of the first few vectors in the list of vectors, the number of vectors depending on the details of the plot unless specified. The plot is prepared to appear but not shown if SHOW is NIL. It appears on the desktop when IN is not specified; in IN when IN is specified to be a container; in the XLispStat window if IN is specified as NIL; or in  *active-container* if IN is specified as T and *active-container*  is a container window (desktop, if *active-container* is not a container window). The plot will include variable-labels, point-labels and legends, as specified. The plot will have a close box which will be de-activated when GO-AWAY is T. When CONTENT-ONLY is T the button bars, legends and overlays do not appear. When HELP-BAR is NIL the help-bar does not appear. When POP-UP is NIL the pop-up menus are not available. 
    Makes one or many dot plots, with optional boxplots and/or diamondplots superimposed.  Dots are jittered unless JITTER is nil. Points in parallel plots may be connected if each plot has the same number of observations. Parallel plots may also be connected with mean or median line.   Boxplots are based on the five number summary.  Diamond plots are based on the mean and standard deviation.  Widths of boxes and diamonds are proportional to number of observations in the sequence. Categoried side-by-side box/diamonds plots are made of a single variable classified into the categories of a category variable when CATEGORY is T.
    The BOXES, DIAMONDS, MEAN-LINE and MEDIAN-LINE  arguments determine which features are initially displayed.  Default is that only boxes are displayed. ENABLE-CONNECT-POINTS displays the connect box and enables point connections, the points being initially connected if CONNECT-POINTS is also true (only appropriate for multivariate data). ENABLE-EQUATE displays equate box and, if EQUATE is also T normalizes all variables onto comparable scales. Written by Forrest W. Young"
  (let* ((actcon *active-container*)
         (in? (if in??? in? in??))
         (graph-frame (graph-frame :show nil))
         (pop-out (send graph-frame :seen-in in in?))
         (container (if (equal pop-out t) graph-frame pop-out))
         (graph-data (before-new-plot data ok-var-types))
         (graph))
    (unless variable-labels (setf variable-labels (second graph-data)))
    (unless point-labels (setf point-labels (third graph-data)))
    (setf graph-data (first graph-data))
    (when (not (first size))
          (setf size (list (min (first (- (screen-size) 100))
                                (* (max 3 (length variable-labels)) 80))
                           (second size))))
    (unless title 
            (setf title (if (> (length graph-data) 1) 
                            "Side-By-Side Box Plots" 
                            "Box Plot")))
    (unless legend2 (setf legend2 title))
    (setf graph
          (send boxplot-proto :new graph-data                        
                :variable-labels variable-labels :point-labels point-labels
                :show nil                        :top-most top-most
                :container container             :pop-out pop-out
                :actcon actcon
                :location location               :size size 
                :menu menu                       :title title 
                :legend1 legend1                 :legend2 legend2
                :go-away go-away                 :content-only content-only
                ;MODULE-SPECIFIC ARGUMENTS
                :boxes boxes :diamonds diamonds :jitter jitter
                :median-line median-line :mean-line mean-line
                :enable-connect-points enable-connect-points 
                :connect-points connect-points
                :enable-equate enable-equate :equate equate
                :y-axis-label y-axis-label  :x-axis-label x-axis-label))
    (when graph
          (send graph :mouse-mode 'brushing)
          (send graph :connect-points connect-points)
          (send graph :after-new-plot pop-out top-most show size container))
    graph))


(defun parallel-coordinates-plot 
  (&optional data &key (title "Parallel Coordinates Plot") location (size '(320 320))
             variable-labels point-labels (go-away t) (show t)
             (legend1 (send current-object :name))  (legend2 " ")
             (in nil in?) (content-only nil)
             (y-axis-label "Data") (x-axis-label "Variables") (category nil))
  (let ((pcp (box-or-diamond-plot data :ok-var-types '(numeric) :title "Parallel Coordinates Plot" :in in :in? in? :show show :variable-labels variable-labels :point-labels point-labels :legend1 legend1 :legend2 legend2 :location location :size size :go-away go-away :content-only content-only :y-axis-label y-axis-label :x-axis-label x-axis-label :category nil :boxes nil :diamonds nil :median-line nil :mean-line nil :equate t :enable-equate t :jitter nil :connect-points t :enable-connect-points t)))
    ;(send pcp :switch-connect-points)
    pcp))


(defun grouped-box-or-diamond-plot 
  (&optional data &key (ok-var-types '(numeric)) 
             (title "Grouped Box or Diamond Plot") 
             location (size '(320 320))
             ;do not use :in?, :in??, or :in??? - reserved for system use
             (in nil in??) (in? nil in???) 
             (go-away t) (show t) (top-most t) 
             (legend1 (send current-object :name))  (legend2 " ")
             (content-only nil)
             point-labels 
             (jitter t) (boxes t) diamonds 
             equate median-line mean-line)
"Args:  data
&key title  point-labels 
     (jitter t) (boxes t) (diamond nil) 
     equate median-line mean-line 
     (legend1 (send current-object :name)) (legend2 " ")
     location size (go-away t) (show t))
DATA is nil or an object, a sequence, a list of sequences or a matrix. Defaults to the first active numeric and category variables in the current-data if not specified. Makes categorized boxplot, diamond or dot plots, there being a plot for every category of CATEGORY variable, the plot being of all observations of NUMERIC VARIABLE that fall in the category of CATEGORY VARIABLE.  Dots are jittered unless JITTER is nil. Boxplots are based on the five number summary.  Diamond plots are based on the mean and standard deviation.  Widths of boxes and diamonds are proportional to number of observations in the sequence. The BOXES, DIAMONDS, MEAN-LINE and MEDIAN-LINE arguments determine which features are initially displayed.  Default is that only boxes are displayed. CONNECT-POINTS must be true to enable point connections (only appropriate for multivariate data). Points not jittered when connected. EQUATE displays equate box and normalizes all variables onto comparable scales."

  (cond
    ((objectp data))
    ((not data) (setf data $))
    (t (fatal-message "Categorical BoxPlot data must be a data object.")))
  (let* ((actcon *active-container*)
         (in? (if in??? in? in??))
         (graph-frame (graph-frame :show nil))
         (pop-out (send graph-frame :seen-in in in?))
         (container (if (equal pop-out t) graph-frame pop-out))
         (category-labels 
          (remove-duplicates 
           (select (send data :active-data-lists '(category)) 0) :test #'equal))
         (variable-labels 
          (list (select (send data :active-variables '(category)) 0)
                (select (send data :active-variables '(numeric)) 0)))
         (numeric-variable (select (send data :active-data-lists '(numeric)) 0))
         (category-variable (select (send data :active-data-lists '(category)) 0))
         (grouped-data (categorize-numeric-variable numeric-variable category-variable))
         (point-labels (if point-labels point-labels
                           (mapcar #'(lambda (i)
                                       (format nil "Obs~a" i)) 
                                   (iseq (length numeric-variable)))))
         (graph)
         )
    (when (not (first size))
          (setf size (list (min (first (- (screen-size) 100))
                                (* (max 3 (length variable-labels)) 80))
                           (second size))))
    
    (unless legend2 (setf legend2 title))
    (setf graph
          (send boxplot-proto :new grouped-data :title title :point-labels point-labels
                :variable-labels category-labels :location location :boxes boxes
                :diamonds diamonds :median-line median-line :mean-line mean-line
                :enable-connect-points nil :enable-equate equate :category t
                :box-button t :diamond-button t :median-line-button nil 
                :mean-line-button nil :equate-button t :connect-points-button nil 
                :jitter jitter :size size :go-away go-away :show nil
                :content-only content-only
                :x-axis-label (if variable-labels (first variable-labels) " ")
                :y-axis-label (if variable-labels (second variable-labels) " ")
                :legend1 legend1 :legend2 legend2))
    (when graph
          (send graph :mouse-mode 'brushing)
          (send graph :after-new-plot pop-out top-most show size container))
    graph))



(defun dot-plot 
  (&optional data 
             &key (title "Dot Plot") location (size '(300 300))
             variable-labels point-labels (go-away t) (show t)
             (legend1 (send current-object :name))  (legend2 " ")
             (content-only nil) (jitter t) (equate t) (connect-points t)
             (x-axis-label " ") (y-axis-label "Data")
             (in nil in?)
             )
  (box-or-diamond-plot data :ok-var-types '(numeric) :title "Dot Plot" :in in :in? in? :show show :variable-labels variable-labels :point-labels point-labels :legend1 legend1 :legend2 legend2 :location location :size size :go-away go-away :content-only content-only :y-axis-label y-axis-label :x-axis-label x-axis-label :category nil :boxes nil :diamonds nil :median-line nil :mean-line nil :equate equate :enable-equate t :jitter t :connect-points connect-points :enable-connect-points connect-points ))

       
(defun pc-plot (&rest args) (apply #'parallel-coordinates-plot args))

(defun diamond-plot (&optional data &key (title "Diamond Plot") location (size '(300 300))
                           variable-labels point-labels (go-away t) (show t)
                           (legend1 (send current-object :name))  (legend2 " ")
                           (in nil in?) (content-only nil)
                           (y-axis-label "Data") (x-axis-label " ") (category nil)
                           (boxes nil) (diamonds t) (median-line nil) (mean-line t) 
                           (equate t) (connect-points t) (content-only nil) (jitter t) 
                           )
"Args: ((&optional data &key (title \"Diamond Plot\") location size
                           variable-labels point-labels (go-away t) (show t)
                           (legend1 (send current-object :name))  (legend2 \" \")

                           (y-axis-label \"Data\") (x-axis-label \" \") (category nil)
                           (boxes nil) (diamonds t) (median-line nil) (mean-line t) 
                           (equate t) (connect-points t) (content-only nil) (jitter t)
DATA is nil or an object, a sequence, a list of sequences or a matrix. Defaults to the active numeric variables in the current-data if not specified. Plot is of the sequence or sequences in the list or the columns of the matrix. Makes one or many parallel dot plots, with optional boxplots and/or diamondplots superimposed.  Dots are jittered unless JITTER is nil. Points in parallel plots may be connected if each plot has the same number of observations. Parallel plots may also be connected with mean or median line.   Boxplots are based on the five number summary.  Diamond plots are based on the mean and standard deviation.  Widths of boxes and diamonds are proportional to number of observations in the sequence. The BOXES, DIAMONDS, MEAN-LINE and MEDIAN-LINE  arguments determine which features are initially displayed.  Default is that only boxes are displayed. CONNECT-POINTS must be true to enable point connections (only appropriate for multivariate data). Points not jittered when connected. EQUATE displays equate box and normalizes all variables onto comparable scales. The arguments ending with -BUTTON determine which buttons will be on the toolbar. Plot appears in the active container, if there is one, or on the desktop when there is none."
  (box-or-diamond-plot data :ok-var-types '(numeric) :title "Dot Plot" :in in :in? in? :show show :variable-labels variable-labels :point-labels point-labels :legend1 legend1 :legend2 legend2 :location location :size size :go-away go-away :content-only content-only :help-bar nil :pop-up t :y-axis-label y-axis-label :x-axis-label x-axis-label :category nil :boxes nil :diamonds t :median-line nil :mean-line nil :equate t :enable-equate t :jitter t :connect-points t :enable-connect-points t))


(defun box-plot (&optional data &key (title "Diamond Plot") location (size '(300 300))
                           variable-labels point-labels (go-away t) (show t)
                           (legend1 (send current-object :name))  (legend2 " ")
                           (in nil in?) (content-only nil)
                           (y-axis-label "Data") (x-axis-label " ") (category nil)
                           (boxes nil) (diamonds t) (median-line nil) (mean-line t) 
                           (equate t) (connect-points t) (content-only nil) (jitter t) 
                           )
"Args: ((&optional data &key (title \"Diamond Plot\") location size
                           variable-labels point-labels (go-away t) (show t)
                           (legend1 (send current-object :name))  (legend2 \" \")

                           (y-axis-label \"Data\") (x-axis-label \" \") (category nil)
                           (boxes nil) (diamonds t) (median-line nil) (mean-line t) 
                           (equate t) (connect-points t) (content-only nil) (jitter t)
DATA is nil or an object, a sequence, a list of sequences or a matrix. Defaults to the active numeric variables in the current-data if not specified. Plot is of the sequence or sequences in the list or the columns of the matrix. Makes one or many parallel dot plots, with optional boxplots and/or diamondplots superimposed.  Dots are jittered unless JITTER is nil. Points in parallel plots may be connected if each plot has the same number of observations. Parallel plots may also be connected with mean or median line.   Boxplots are based on the five number summary.  Diamond plots are based on the mean and standard deviation.  Widths of boxes and diamonds are proportional to number of observations in the sequence. The BOXES, DIAMONDS, MEAN-LINE and MEDIAN-LINE  arguments determine which features are initially displayed.  Default is that only boxes are displayed. CONNECT-POINTS must be true to enable point connections (only appropriate for multivariate data). Points not jittered when connected. EQUATE displays equate box and normalizes all variables onto comparable scales. The arguments ending with -BUTTON determine which buttons will be on the toolbar. Plot appears in the active container, if there is one, or on the desktop when there is none."
  (box-or-diamond-plot data :ok-var-types '(numeric) :title "Dot Plot" :in in :in? in? :show show :variable-labels variable-labels :point-labels point-labels :legend1 legend1 :legend2 legend2 :location location :size size :go-away go-away :content-only content-only :help-bar nil :pop-up t :y-axis-label y-axis-label :x-axis-label x-axis-label :category nil :boxes t :diamonds nil :median-line nil :mean-line nil :equate t :enable-equate t :jitter t :connect-points t :enable-connect-points t))



(defun labels-plot 
  (&optional data 
        &key (style 0) 
             (help-only nil)
             (show t)
             (top-most t) 
             (location '(50 50)) 
             (size '(125 320))
             (menu t) 
             (title "Labels") 
             (go-away t) 
             (content-only nil)
             (in nil in??) 
             (in? nil in???))
  (let* ((actcon *active-container*)
         (in? (if in??? in? in??))
         (graph-frame (graph-frame :show nil))
         (pop-out (send graph-frame :seen-in in in?))
         (container (if (equal pop-out t) graph-frame pop-out))
         (names (before-labels-plot data))
         (vertical t)
         (graph))
    (when help-only (setf vertical nil))
    (setf graph (name-list
                 names 
                 :help-only help-only
                 :show t
                 :title title 
                 :size size 
                 :location '(3000 3000)
                 :in container 
                 :style style 
                 :vertical vertical))
    (if actcon 
        (enable-container actcon)
        (disable-container))
    (when graph
          (send graph :pop-out nil)
          (send (send graph :container)
                :after-new-container pop-out top-most show size container)
          (when show (apply #'send (send graph :container) :location location)))
    (send graph :container)))

#|
(defun name-list2 (names &key help-only show title size location style (vertical t))
  (setf nl (name-list names
                      :help-only help-only 
                       :show show
                       :title title
                       :size size
                       :location location
                       :style 0
                       :vertical t))
  (setf nlc (send nl :container))
  (send nlc :pop-out t))
|#


  (defun before-labels-plot (data)
    "ARGS: DATA
Prepares data for input to a labels plot module. DATA may be NIL, a DATA OBJECT, or a LIST of strings. Returns a list of labels"
    (let* ((variable-labels) 
           (point-labels) 
           (title) 
           (result))
      (unless data (setf data $))
      (setf result
            (cond
              ((objectp data)                                   ;data is an object
               (send data :active-labels))
              ((and (listp data) (stringp (first data)))        ;data is a list of strings
               data)))
      result))